home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / ext / safe / safe.xs < prev   
Encoding:
Text File  |  1996-02-15  |  2.5 KB  |  132 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. /* maxo should never differ from MAXO but leave some room anyway */
  6. #define OP_MASK_BUF_SIZE (MAXO + 100)
  7.  
  8. MODULE = Safe    PACKAGE = Safe
  9.  
  10. void
  11. safe_call_sv(package, mask, codesv)
  12.     char *    package
  13.     SV *    mask
  14.     SV *    codesv
  15.     CODE:
  16.     int i;
  17.     char *str;
  18.     STRLEN len;
  19.     char op_mask_buf[OP_MASK_BUF_SIZE];
  20.  
  21.     assert(maxo < OP_MASK_BUF_SIZE);
  22.     ENTER;
  23.     SAVETMPS;
  24.     save_hptr(&defstash);
  25.     save_aptr(&endav);
  26.     SAVEPPTR(op_mask);
  27.     op_mask = &op_mask_buf[0];
  28.     str = SvPV(mask, len);
  29.     if (maxo != len)
  30.         croak("Bad mask length");
  31.     for (i = 0; i < maxo; i++)
  32.         op_mask[i] = str[i];
  33.     defstash = gv_stashpv(package, TRUE);
  34.     endav = (AV*)sv_2mortal((SV*)newAV()); /* Ignore END blocks for now */
  35.     GvHV(gv_fetchpv("main::", TRUE, SVt_PVHV)) = defstash;
  36.     PUSHMARK(sp);
  37.     i = perl_call_sv(codesv, G_SCALAR|G_EVAL|G_KEEPERR);
  38.     SPAGAIN;
  39.     ST(0) = i ? newSVsv(POPs) : &sv_undef;
  40.     PUTBACK;
  41.     FREETMPS;
  42.     LEAVE;
  43.     sv_2mortal(ST(0));
  44.  
  45. void
  46. op_mask()
  47.     CODE:
  48.     ST(0) = sv_newmortal();
  49.     if (op_mask)
  50.         sv_setpvn(ST(0), op_mask, maxo);
  51.  
  52. void
  53. mask_to_ops(mask)
  54.     SV *    mask
  55.     PPCODE:
  56.     STRLEN len;
  57.     char *maskstr = SvPV(mask, len);
  58.     int i;
  59.     if (maxo != len)
  60.         croak("Bad mask length");
  61.     for (i = 0; i < maxo; i++)
  62.         if (maskstr[i])
  63.         XPUSHs(sv_2mortal(newSVpv(op_name[i], 0)));
  64.  
  65. void
  66. ops_to_mask(...)
  67.     CODE:
  68.     int i, j;
  69.     char mask[OP_MASK_BUF_SIZE], *op;
  70.     Zero(mask, sizeof mask, char);
  71.     for (i = 0; i < items; i++)
  72.     {
  73.         op = SvPV(ST(i), na);
  74.         for (j = 0; j < maxo && strNE(op, op_name[j]); j++) /* nothing */ ;
  75.         if (j < maxo)
  76.         mask[j] = 1;
  77.         else
  78.         {
  79.         Safefree(mask);
  80.         croak("bad op name \"%s\" in mask", op);
  81.         }
  82.     }
  83.     ST(0) = sv_2mortal(newSVpv(mask,maxo));
  84.  
  85. void
  86. opname(...)
  87.     PPCODE:
  88.     int i, myopcode;
  89.     for (i = 0; i < items; i++)
  90.     {
  91.         myopcode = SvIV(ST(i));
  92.         if (myopcode < 0 || myopcode >= maxo)
  93.         croak("opcode out of range");
  94.         XPUSHs(sv_2mortal(newSVpv(op_name[myopcode], 0)));
  95.     }
  96.  
  97. void
  98. opdesc(...)
  99.     PPCODE:
  100.     int i, myopcode;
  101.     for (i = 0; i < items; i++)
  102.     {
  103.         myopcode = SvIV(ST(i));
  104.         if (myopcode < 0 || myopcode >= maxo)
  105.         croak("opcode out of range");
  106.         XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
  107.     }
  108.  
  109. void
  110. opcode(...)
  111.     PPCODE:
  112.     int i, j;
  113.     char *op;
  114.     for (i = 0; i < items; i++)
  115.     {
  116.         op = SvPV(ST(i), na);
  117.         for (j = 0; j < maxo; j++) {
  118.         if (strEQ(op, op_name[j]) || strEQ(op, op_desc[j]))
  119.             break;
  120.         }
  121.         if (j == maxo)
  122.         croak("bad op name \"%s\"", op);
  123.         XPUSHs(sv_2mortal(newSViv(j)));
  124.     }
  125.  
  126. int
  127. MAXO()
  128.     CODE:
  129.     RETVAL = maxo;
  130.     OUTPUT:
  131.     RETVAL
  132.